home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 14 / CU Amiga Magazine's Super CD-ROM 14 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-09].iso / CUCD / Programming / GMS / Source / E / Demos / Kohonen.e < prev    next >
Encoding:
Text File  |  1997-05-03  |  3.6 KB  |  141 lines
  1. /* Kohonen Feature Maps in E, implemented with integers
  2. **
  3. ** Kohonen feature maps are special types of neural nets, and
  4. ** this implementation shows graphically how they organise themselves
  5. ** after a while.
  6. **
  7. ** [This demo from the AmigaE archives has been converted to work with GMS.
  8. ** It is at about 33% faster than the original intuition version.]
  9. */
  10.  
  11. CONST ONE=1024*16, KSHIFT=14, KSIZE=7, MAXTIME=500, DELAY=0
  12. CONST KSTEP=ONE/KSIZE, KNODES=KSIZE+1, ARSIZE=KSIZE*KSIZE
  13. CONST XRED=64, YRED=128, XOFF=10, YOFF=20
  14.  
  15. MODULE 'games','games/games'
  16.  
  17. /*=========================================================================*/
  18.  
  19. PROC main()
  20.  DEF screen:PTR TO gamescreen,map,t,input,x,y
  21.  
  22.  IF gmsbase := OpenLibrary('GMS:GPI/Master.GPI',0)
  23.   SetUserPrefs('Kohenen')
  24.   IF (screen := AddScreen([TAGS,0,
  25.      GSA_PALETTE,[$000000,$f0f0f0],
  26.      GSA_SCRWIDTH,320,
  27.      GSA_SCRHEIGHT,256,
  28.      GSA_PLANES,2,
  29.      GSA_SCRATTRIB,DBLBUFFER OR CENTRE,
  30.      GSA_SCRMODE,HIRES,
  31.      TAGEND]))
  32.  
  33.    ShowScreen(screen)
  34.  
  35.    map:=kohonen_init(KSIZE,KSIZE,2)
  36.  
  37.    FOR t:=0 TO MAXTIME-1
  38.      input := [Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  39.      x,y := kohonen_BMU(map,input)
  40.      kohonen_plot(map,screen,x,y)
  41.      kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  42.    ENDFOR
  43.  
  44.    WaitLMB()
  45.    DeleteScreen(screen)        
  46.       ENDIF
  47.    CloseGMS()
  48.    ENDIF
  49. ENDPROC
  50.  
  51. /*=========================================================================*/
  52.  
  53. PROC kohonen_plot(map,screen:PTR TO gamescreen,bx,by)
  54. DEF x,y,n:PTR TO LONG,cx,cy,i,ii,sx[ARSIZE]:ARRAY OF LONG
  55. DEF sy[ARSIZE]:ARRAY OF LONG
  56.  
  57.   ClrScreen(screen,BUFFER2)
  58.   FOR x:=0 TO KSIZE-1
  59.     FOR y:=0 TO KSIZE-1
  60.       n := kohonen_node(map,x,y)
  61.       i := x*KSIZE+y
  62.       ii := x-1*KSIZE+y
  63.       sx[i] := cx := s(n[0]/XRED+XOFF)
  64.       sy[i] := cy := s(n[1]/YRED+YOFF)
  65.       IF x>0 THEN DrawLine(screen,BUFFER2,sx[ii],sy[ii],cx,cy,1)
  66.       IF y>0 THEN DrawLine(screen,BUFFER2,sx[i-1],sy[i-1],cx,cy,1)
  67.     ENDFOR
  68.   ENDFOR
  69.  
  70.   n:=kohonen_node(map,bx,by)
  71.   DrawPixel(screen,BUFFER2,s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),1)
  72.   WaitVBL()
  73.   SwapBuffers(screen)
  74. ENDPROC
  75.  
  76. /*=========================================================================*/
  77.  
  78. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  79.  
  80. /*=========================================================================*/
  81.  
  82. PROC kohonen_BMU(map,i:PTR TO LONG)
  83. DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  84.  
  85.   len:=ListLen(i)-1
  86.   FOR x:=0 TO KSIZE-1
  87.     FOR y:=0 TO KSIZE-1
  88.       n:=kohonen_node(map,x,y)
  89.       act:=0
  90.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  91.       IF act<bestact
  92.          bestx := x
  93.          besty := y
  94.          bestact := act
  95.       ENDIF
  96.     ENDFOR
  97.   ENDFOR
  98.  
  99. ENDPROC bestx,besty
  100.  
  101. /*=========================================================================*/
  102.  
  103. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  104. DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  105.  
  106.   bell:=[50,49,47,40,25,13,10,8,6,5,4,3,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  107.   len:=ListLen(i)-1
  108.  
  109.   FOR x:=0 TO KSIZE-1
  110.     FOR y:=0 TO KSIZE-1
  111.       n:=kohonen_node(m,x,y)
  112.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  113.       IF d>0
  114.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  115.       ENDIF
  116.     ENDFOR
  117.   ENDFOR
  118. ENDPROC
  119.  
  120. /*=========================================================================*/
  121.  
  122. PROC kohonen_node(map:PTR TO LONG,x,y)
  123.   DEF r:PTR TO LONG
  124.   r:=map[x]
  125. ENDPROC r[y]
  126.  
  127. /*=========================================================================*/
  128.  
  129. PROC kohonen_init(numx,numy,numw)
  130. DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  131.   NEW m[numx]
  132.   FOR a:=0 TO numx-1
  133.     m[a]:=NEW r[numy]
  134.     FOR b:=0 TO numy-1
  135.       r[b]:=NEW w[numw]
  136.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  137.     ENDFOR
  138.   ENDFOR
  139. ENDPROC m
  140.  
  141.